unit SpeechMatchFeedback;

interface

uses
  WaveRecorders, Classes, SysUtils, WaveStorage;

type
  TMatchEvent = procedure(ADegree: Integer) of object;
  TTimeout = procedure() of object;
  TOnEndEvent = procedure(ADuration: Integer) of object;

  TSpeechMatchFeedback = class
  private
    FAnswer: string;
    FTimeout: Integer;
    FOnTimeout: TTimeout;
    FOnMatch: TMatchEvent;
    FRecorder: TLiveAudioRecorder;
    FStart: Integer;
    FOnEnd: TOnEndEvent;
    FWaveFileName: string;
    FWaveFile: TWaveFile;

    procedure SetAnswer(const Value: string);
    procedure SetOnMatch(const Value: TMatchEvent);
    procedure SetOnTimeout(const Value: TTimeout);
    procedure SetTimeout(const Value: Integer);
    procedure ResponseRecorderData(Sender: TObject; const Buffer: Pointer;
      BufferSize: Cardinal; var FreeIt: Boolean);
    procedure DoMatch;
    procedure SetOnEnd(const Value: TOnEndEvent);
  public
    constructor Create;
    destructor  Destroy; override;

    procedure Start;
    procedure Stop;
    property Timeout: Integer read FTimeout write SetTimeout;
    property Answer: string read FAnswer write SetAnswer;
    property OnMatch: TMatchEvent read FOnMatch write SetOnMatch;
    property OnTimeout: TTimeout read FOnTimeout write SetOnTimeout;
    property OnEnd: TOnEndEvent read FOnEnd write SetOnEnd;
  end;


implementation

uses
  Windows, CommonUtils, MMSystem, WaveUtils;


function GetCommandLineOutput(const ACommandLine, AWorkDir: string;
  out ExitCode: LongWord): string;
var
  strCommandLine,
  strWorkDir: string;
  strOutLine,
  strBuffer: AnsiString;
  bRunResult: Boolean;
  nBytesRead: Cardinal;
  nStdOutPipeRead,
  nStdOutPipeWrite: THandle;
  PI: TProcessInformation;
  SA: TSecurityAttributes;
  SI: TStartupInfo;
begin
  with SA do
  begin
    nLength := SizeOf(SA);
    bInheritHandle := True;
    lpSecurityDescriptor := nil;
  end;
  if not CreatePipe(nStdOutPipeRead, nStdOutPipeWrite, @SA, 0) then
    RaiseLastOSError;
  try
    with SI do
    begin
      FillChar(SI, SizeOf(SI), 0);
      cb := SizeOf(SI);
      dwFlags := STARTF_USESHOWWINDOW or STARTF_USESTDHANDLES;
      wShowWindow := SW_HIDE;
      hStdInput := GetStdHandle(STD_INPUT_HANDLE);
      hStdOutput := nStdOutPipeWrite;
      hStdError := nStdOutPipeWrite;
    end;
    if DirectoryExists(AWorkDir) then
      strWorkDir := AWorkDir
    else strWorkDir := GetCurrentDir;
    strCommandLine := ACommandLine;
    UniqueString(strCommandLine);
    bRunResult := CreateProcess(nil, PChar(strCommandLine), nil, nil, True, 0, nil,
      PChar(strWorkDir), SI, PI);
    CloseHandle(nStdOutPipeWrite);
    if bRunResult then
    try
      strOutLine := '';
      SetLength(strBuffer, MAXBYTE);
      repeat
        nBytesRead := 0;
        bRunResult := ReadFile(nStdOutPipeRead, PAnsiChar(strBuffer)^, Length(strBuffer), nBytesRead, nil);
        if nBytesRead > 0 then
          strOutLine := strOutLine + Copy(strBuffer, 1, nBytesRead);
      until not bRunResult or (nBytesRead = 0);
      WaitForSingleObject(PI.hProcess, INFINITE);
      GetExitCodeProcess(PI.hProcess, ExitCode);
    finally
      CloseHandle(PI.hThread);
      CloseHandle(PI.hProcess);
    end
    else RaiseLastOSError;
  finally
    CloseHandle(nStdOutPipeRead);
    Result := string(strOutLine);
  end;
end;


{ TSpeechMatchFeedback }

constructor TSpeechMatchFeedback.Create;
begin
  FRecorder := TLiveAudioRecorder.Create(nil);
  FRecorder.PCMFormat := Mono8Bit8000Hz;
end;

destructor TSpeechMatchFeedback.Destroy;
begin
  FreeAndNil(FRecorder);

  inherited;
end;


procedure TSpeechMatchFeedback.DoMatch;
const
  ExecFmt = 'cmd.exe /c  python %s\py\calc.py "%s" "%s"';
var
  sDist: string;
  lc: LongWord;
  sFileName: string;
begin
  FWaveFile.EndRewrite;
  sFileName := FWaveFileName + '_';
  if FileExists(sFileName) then
    DeleteFile(PChar(sFileName));
  FWaveFile.SaveToFile(sFileName);
  sDist := GetCommandLineOutput(Format(ExecFmt, [GetExePath, FWaveFileName, FAnswer]), '', lc);
  if Assigned(FOnMatch) then
    FOnMatch(StrToIntDef(sDist, 0));
end;

procedure TSpeechMatchFeedback.ResponseRecorderData(Sender: TObject;
  const Buffer: Pointer; BufferSize: Cardinal; var FreeIt: Boolean);
var
  oTemp: TMemoryStream;
begin
  FreeIt := True;
  FWaveFile.Write(Buffer^, BufferSize);
  if (GetTickCount - FStart) > FTimeout then
  begin
    DoMatch;
    Stop;

    if Assigned(FOnTimeout) then
      FOnTimeout();
  end
  else begin
    oTemp := TMemoryStream.Create;
    try
      oTemp.Size := BufferSize;
      oTemp.Position := 0;
      CopyMemory(oTemp.Memory, Buffer, BufferSize);
      if IsEnd(oTemp, 0) then
      begin
        DoMatch;
        if Assigned(FOnEnd) then
          FOnEnd(GetTickCount - FStart);
      end;
    finally
      FreeAndNil(oTemp);
    end;
  end;
end;

procedure TSpeechMatchFeedback.SetAnswer(const Value: string);
begin
  FAnswer := Value;
end;

procedure TSpeechMatchFeedback.SetOnEnd(const Value: TOnEndEvent);
begin
  FOnEnd := Value;
end;

procedure TSpeechMatchFeedback.SetOnMatch(const Value: TMatchEvent);
begin
  FOnMatch := Value;
end;

procedure TSpeechMatchFeedback.SetOnTimeout(const Value: TTimeout);
begin
  FOnTimeout := Value;
end;

procedure TSpeechMatchFeedback.SetTimeout(const Value: Integer);
begin
  FTimeout := Value;
end;

procedure TSpeechMatchFeedback.Start;
begin
  if Assigned(FWaveFile) then
    FreeAndNil(FWaveFile);
  FWaveFileName := GetExePath + 'temp_match.wav';
  if FileExists(FWaveFileName) then
    DeleteFile(PChar(FWaveFileName));
  FWaveFile := TWaveFile.Create(GetExePath + 'temp_match.wav', fmCreate);
  FWaveFile.BeginRewritePCM(FRecorder.PCMFormat);
  FRecorder.OnData := ResponseRecorderData;
  FRecorder.Active := True;
  FStart := GetTickCount;
end;

procedure TSpeechMatchFeedback.Stop;
begin
  FRecorder.OnData := nil;
  FreeAndNil(FWaveFile);
  FRecorder.Active := False;
  FStart := 0;
end;

end.
